home *** CD-ROM | disk | FTP | other *** search
-
- * PSINPUTP.PRG
- *
- * A DBASE II 16BIT COMMAND FILE to allow input of phone information
- * to PHONE.DBF. Went with this fancy schmancy one to try to eliminate
- * duplicate entries as this database may get quite large
- *
- * Version 1
- * By LTC Denny Hugg
- * ANGSC/DOS Andrews AFB MD 16 Jul 1985
- *
- * Version 2
- * modified by Maj Jim McMurry
- * ANGSC/DOSC Truax Field, WI 15 Jun 1986
- *
- USE PSPHONE
- GO BOTTOM
- STORE # TO last
- USE PSPHONE INDEX PSPHONEI
- ERASE
- * --- we won't reindex unless we need to
- STORE 'N' TO oneadded
- STORE ' ' TO response
- DO WHILE T
- ERASE
- STORE 'T E L E P H O N E E N T R Y / E D I T' TO heading
- DO PSHEADING
- @ 22,79 SAY ' ';
- +'<RETURN> To Exit This Module'
- @ 0, 0 SAY gcuron
- STORE ' ' TO select
- @ 22,26 SAY 'Enter Last Name ' GET select PICTURE '!!!!!!!!!!!'
- READ NOUPDATE
- @ 0, 0 SAY gcuroff
- @ 22, 0 SAY gclearline
- @ 22,79 SAY gclearline
- @ 10, 0 SAY ' '
- * --- give the guy a way out
- * --- we also want no leading blanks 'cause FIND won't find next time
- IF select = ' '
- STORE 10 TO line
- STORE 'No Last Name Entered ... Returning To Phone Menu' TO prompt
- DO PSPROMPT
- IF oneadded = 'N'
- STORE 1 TO counter
- DO WHILE counter < gdelay
- STORE counter + 1 TO counter
- ENDDO
- ELSE
- * --- packing because of problems adding to an indexed file
- * --- in dBase II
- PACK
- ENDIF
- RELEASE ALL EXCEPT g*
- USE
- RETURN
- ENDIF
- IF $(select,1,1) = ' '
- * --- he added some leading space(s)
- STORE 1 TO pointer
- * --- locate the first non-empty character
- DO WHILE $(select,pointer,1) = ' '
- STORE pointer + 1 TO pointer
- ENDDO
- * --- get the non-empty characters
- STORE $(select,pointer,LEN(select)-pointer + 1) TO select
- ENDIF
- RELEASE pointer
- * --- use FIND just to see if one's there because it's so fast
- * --- won't find un-capitalized names in the old database
- * --- got to expect some losses in a big war
- STORE TRIM(select) TO mlname
- FIND &mlname
- * --- if at the end of the file
- IF # = 0
- @ 22,21 SAY 'This Is A New Name ... Enter The Data'
- STORE 0 TO counter
- DO WHILE counter < gdelay
- STORE counter + 1 TO counter
- ENDDO
- APPEND BLANK
- STORE 'Y' TO oneadded
- REPLACE lname WITH mlname
- STORE last + 1 TO last
- ELSE
- ERASE
- STORE 1 TO line
- STORE 'ALL ' + mlname + "S" TO prompt
- DO PSPROMPT
- @ 4, 0 SAY 'Rec # Last Name First Rank O/S U #';
- +' Type Location Phone'
- @ 5, 0 SAY gline
- * --- the find command finds the first record meeting the requirements
- * --- extremely fast. The display/skip combo below results in about
- * --- a 300% time savings over a plain vanilla DISPLAY command as
- * --- you don't have to go through the entire database.
- STORE 0 TO line
- DO WHILE .NOT. EOF .AND. !(lname) = mlname
- IF line = 8 .OR. line = 19
- @ 22,79 SAY ' '+;
- 'More To Come ... Strike Any Key To Continue'
- SET CONSOLE OFF
- WAIT
- SET CONSOLE ON
- ERASE
- STORE 1 TO line
- STORE 'ALL ' + mlname + "S" TO prompt
- DO PSPROMPT
- @ 4, 0 SAY 'Rec # Last Name First Rank O/S U #';
- +' Type Location Phone'
- @ 5, 0 SAY gline
- STORE 0 TO line
- ENDIF
- DISPLAY ' '+lname+' '+fname+' '+rank+' '+;
- offsym+' '+unitno+' '+unitype+' '+icao+;
- ' '+state+' '+avnop+'-'+avnos
- STORE line + 1 TO line
- SKIP
- ENDDO
- STORE ' ' TO select
- @ 0, 0 SAY gcuron
- @ 22,79 SAY ' ';
- +'Enter # To Work On Or <RETURN> To Add A New Record ';
- GET select PICTURE '99999'
- READ NOUPDATE
- @ 0, 0 SAY gcuroff
- IF select = ' '
- APPEND BLANK
- REPLACE lname WITH mlname
- STORE last + 1 TO last
- STORE 'Y' TO oneadded
- ELSE
- IF $(select,1,1) = ' '
- * --- he added some leading space(s)
- STORE 1 TO pointer
- * --- locate the first non-empty character
- DO WHILE $(select,pointer,1) = ' '
- STORE pointer + 1 TO pointer
- ENDDO
- * --- get the non-empty characters
- STORE $(select,pointer,LEN(select)-pointer + 1) TO select
- ENDIF
- RELEASE pointer
- STORE TRIM(select) TO answer
- IF VAL(answer) > last
- ERASE
- STORE 10 TO line
- STORE "That Record Isn't In the Database ... We'll Try Again";
- TO prompt
- DO PSPROMPT
- STORE 0 TO counter
- DO WHILE counter < gdelay
- STORE counter + 1 TO counter
- ENDDO
- LOOP
- ENDIF
- GO VAL(answer)
- ENDIF
- ENDIF
- ERASE
- STORE 2 TO line
- STORE 'T E L E P H O N E E N T R Y / E D I T' TO prompt
- DO PSPROMPT
- @ 0, 0 SAY gcuron
- * --- we're going to force caps to make it look uniform
- @ 5, 4 SAY 'Rank ';
- GET rank PICTURE '!!!!!'
- @ 5,24 SAY 'First Name ';
- GET fname PICTURE '!!!!!!!'
- @ 5,49 SAY 'Last Name '
- @ 5,60 SAY lname
- @ 7, 4 SAY 'Unit No. ';
- GET unitno PICTURE '999'
- @ 9, 4 SAY 'ICAO ';
- GET icao PICTURE '!!!'
- @ 9,29 SAY 'State ';
- GET state PICTURE '!!'
- @ 11, 4 SAY 'Unit Type ';
- GET unitype PICTURE '!!!!!!'
- @ 13, 4 SAY 'Off/Sym ';
- GET offsym PICTURE '!!!!'
- @ 15, 4 SAY 'Phone ';
- GET avnop PICTURE '999'
- @ 15,17 SAY '-';
- GET avnos PICTURE '9999'
- @ 17, 4 SAY 'Subject ';
- GET subject PICTURE '!!!!!!!!!!!!!!!!'
- * --- he can use small letters for remarks if he wants to
- @ 19, 4 SAY 'Remarks ';
- GET rem1
- @ 20,14 GET rem2
- READ
- @ 0, 0 SAY gcuroff
- ENDDO T
- * --- EOF PSINPUTP.PRG
- RG
- 1) = ' '
- * --- he added some leading space(s)
- STORE 1 TO pointer
- * --- locate the first non-empty character
- DO WHILE $(select,pointer,1) = ' '
- STORE pointer + 1 TO pointer
- END
